home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
proteng.zip
/
TERM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-07-16
|
12KB
|
485 lines
{ MiniTerminal program - to show the useage of the Protocol Engine. }
{ (C) 1992 Mark Dignam - OmenTronics - Perth Omen BBS - 3:690/660@fidonet }
{$M 16384,0,150000}
Uses
Dos,crt,Comm,Proteng,Ansi_Drv;
Type
scr = array[1..2000] of
record
character : char;
attribute : byte;
end;
scrprt = ^scr;
Const
BoxCol = White + (Blue * 16);
TextCol = LightCyan;
Baudrates : Array[1..9] of longint = (150,300,600,1200,2400,4800,9600,19200,38400);
Version = 'v0.01';
var
Finish,Doorway : Boolean;
DownDir : String[64];
scrbuff,
savescreen : scrprt;
OldX,Oldy,BoxW,
OldText,Lines,
CurBaud,Curport : Byte;
Regs : Registers;
procedure OnCursor;
begin
Regs.ax := 1 shl 8;
Regs.cx := 6 shl 8 + 7;
intr($10,Regs);
end;
procedure OffCursor;
begin
Regs.ax := 1 shl 8;
Regs.cx := 14 shl 8;
intr($10,Regs);
end;
Function GetPath( Thepath : String) : String;
var
n : NameStr;
e : ExtStr;
d : DirStr;
begin
Fsplit(Thepath,d,n,e);
Getpath := d;
end;
procedure position(x,y,col : byte; ch : char);
var
i : word;
begin
i := ((((y - 1) * 80) + (x - 1)) + 1);
scrbuff^[i].attribute := col;
scrbuff^[i].character := ch;
end;
Procedure Save_Screen;
begin
Oldx := Wherex;
OldY := wherey;
OldText := TextAttr;
if (mem[0000:0449] = $7) then
scrbuff := ptr($b000,0000)
else
scrbuff := ptr($b800,0000);
if memavail >= sizeof(scr) then
begin
New(SaveScreen);
savescreen^ := scrbuff^;
end
else
begin
writeln('Can''t allocate memory for screen image');
halt(1);
end;
OnCursor;
end;
procedure make_window(x1,y1,x2,y2,col,btype : byte);
Const
tl : string[5] = '┌╓╒╔+'; tr : string[5] = '┐╖╕╗+';
bl : string[5] = '└╙╘╚+'; br : string[5] = '┘╜╛╝+';
hs : string[5] = '──══-'; vs : string[5] = '│║│║|';
var
i : word;
temp : String[80];
begin
Save_Screen;
OffCursor;
position(x1,y1,col,tl[btype]);
position(x2,y1,col,tr[btype]);
position(x1,y2,col,bl[btype]);
position(x2,y2,col,br[btype]);
for i := (x1 + 1) to (x2 - 1) do
begin
position(i,y1,col,hs[btype]);
position(i,y2,col,hs[btype]);
end;
for i := (y1 + 1) to (y2 - 1) do
begin
position(x1,i,col,vs[btype]);
position(x2,i,col,vs[btype]);
end;
fillchar(temp[1],x2-x1-1,32);
temp[0] := chr(x2-x1-1);
textAttr := BoxCol;
for i := (y1 + 1) to (y2 - 1) do
begin
gotoxy(x1+1,i);
Write(temp);
end;
window(x1 + 1,y1 + 1,x2 - 1,y2 - 1);
end;
procedure Remove_Window;
begin
scrbuff^ := savescreen^;
Window(1,1,80,25);
TextAttr := OldText;
Gotoxy(OldX,OldY);
OnCursor;
end;
Procedure popup(Message : String);
Var
i,j : Byte;
Begin
i := Length(message);
j := 40 - (i shr 1);
make_window(j-2,10,j+i+1,12,White + (blue * 16),1);
GotoXy(2,1);
Write(message);
Delay(500);
Remove_Window;
end;
Procedure PopupLines(Message : String; MaxLines,MaxWidth : Byte);
Var
i,j : Byte;
Begin
If (MaxLines > 0) and (maxlines < 25) then
Begin
Boxw := MaxWidth;
i := Boxw Div 2;
j := 40 - i;
make_window(j-2,8,j+Boxw+1,10+MaxLines,white + (Blue* 16),1);
Lines := 1;
end;
i := (Boxw - length(Message)) Div 2;
Gotoxy(2 + i,Lines);
Inc(Lines);
Write(message);
end;
Procedure Currentsettings;
var
temp1,temp2 : String;
Begin
Str(Baudrates[curbaud],temp1);
Str(CurPort,temp2);
Popup('Current Baud rate is '+temp1+' using comm port '+temp2);
end;
Procedure ShowHelp;
var
ch : char;
temp1,temp2 : String;
Begin
Str(Baudrates[curbaud],temp1);
Str(CurPort,temp2);
PopupLines('The Help Screen for Term',12,40);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Alt_X - Exit',0,0);
PopupLines('Alt_J - Dos Shell',0,0);
PopupLines('Alt_B - change baud rate',0,0);
PopupLines('Alt_P - change Comm port',0,0);
PopupLines('Alt_H - Drop Dtr and hang up',0,0);
PopupLines('PageUp - UpLoad file to remote',0,0);
Popuplines('PageDown - Download file from remote',0,0);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Speed is '+temp1+' baud - Port is '+Temp2,0,0);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Hit Any Key',0,0);
ch := readkey;
remove_Window;
end;
Procedure HangUp;
begin
Comm_Dtr_off;
Delay(1000);
Comm_Dtr_On;
end;
Procedure SetPort;
var
GoodPort : Boolean;
begin
Comm_Deinit;
Inc(Curport);
If Curport = 5 then curport := 1;
repeat
Goodport := comm_init(BaudRates[CurBaud],CurPort);
If Not Goodport Then Inc(CurPort);
If Curport = 5 then curport := 1;
Until Goodport;
CurrentSettings;
end;
Procedure SetBaudRate;
begin
Inc(Curbaud);
if Curbaud > 9 then Curbaud := 1;
Comm_SetDirect(BaudRates[CurBaud]);
Currentsettings;
end;
Procedure UpLoadfiles;
var
Ch : Char;
Fname,temp1,temp2 : String;
GoodFile : Boolean;
Sr : SearchRec;
i,j : Byte;
begin
PopupLines('Uploading - ',5,20);
Popuplines('<X> - XModem ',0,0);
Popuplines('<1> - 1KXmodem',0,0);
Popuplines('<Y> - YModem ',0,0);
Popuplines('<Z> - ZModem ',0,0);
Popuplines('<P> - Yapp ',0,0);
Ch := readKey;
ch := upcase(ch);
Remove_Window;
If (ch in ['X','1','Y','Z','P']) then
begin
Popuplines('',2,74);
PopUpLines('Filename(s) to send ->____________________________________________________',0,0);
Gotoxy(24,2);
OnCursor;
Readln(fname);
Remove_Window;
If Length(Fname) = 0 then
Ch := chr(0)
Else
Begin
j := 0;
For i := 1 to length(Fname) do
if fname[i] in [' ',';'] then fname[i] := ',';
repeat
i := pos(',',fname);
if I = 0 then i := Length(fname) + 1;
temp1 := copy(fname,1,i-1);
Delete(fname,1,i);
Temp2 := Getpath(temp1);
FindFirst(temp1,$27,sr);
While Doserror = 0 do
begin
inc(j);
Thenames[j] := Temp2 + sr.name;
FindNext(sr);
end;
Until Length(Fname) = 0;
NumberofFiles := j;
end;
Case ch of
'X' : Goodfile := XmodemTx;
'1' : Goodfile := Xmodem1KTx;
'Y' : Goodfile := YmodemtX;
'Z' : Goodfile := ZmodemtX;
'P' : Goodfile := YapptX;
end;
end;
end;
procedure Downloadfiles;
var
Ch : Char;
Fname : String;
GoodFile : Boolean;
begin
PopupLines('Downloading - ',5,20);
Popuplines('<X> - XModem ',0,0);
Popuplines('<1> - 1KXmodem',0,0);
Popuplines('<Y> - YModem ',0,0);
Popuplines('<Z> - ZModem ',0,0);
Popuplines('<P> - Yapp ',0,0);
Ch := readKey;
ch := upcase(ch);
Remove_Window;
If (ch in ['X','1','Y','Z','P']) then
begin
If Ch in ['X','1'] then
begin
Popuplines('',2,50);
PopUpLines('Filename to receive ->___________________________',0,0);
Gotoxy(24,2);
OnCursor;
Readln(fname);
Remove_Window;
If Length(Fname) = 0 then Ch := chr(0);
Thenames[1] := Downdir + fname;
end
else
Thenames[1] := DownDir;
Case ch of
'X','1' : Goodfile := XmodemRx;
'Y' : Goodfile := YmodemRX;
'Z' : Goodfile := ZmodemRX;
'P' : Goodfile := YappRX;
end;
end;
end;
Procedure GetParms;
var
l : longint;
I : Byte;
j : Integer;
temp : String;
ch : Char;
begin
if Paramcount > 0 then
begin
for i := 1 to paramcount do
begin
temp := Paramstr(i);
if temp[1] = '-' then Delete(temp,1,1);
Ch := upcase(Temp[1]);
Delete(temp,1,1);
Case ch of
'B' : Begin
Val(temp,l,j);
If (j = 0) then
repeat
inc(j);
until l <= BaudRates[j];
CurBaud := j;
end;
'D' : begin
DownDir := temp;
If DownDir[Length(downdir)] <> '\' then
DownDir := Downdir + '\';
end;
'P' : Begin
Val(temp,l,j);
If j = 0 then CurPort := Byte(l);
end;
end;
end;
end;
end;
Procedure DosShell;
begin
Save_Screen;
writeln('Going to dos');
Exec(GetEnv('COMSPEC'),'');
Remove_Window;
end;
Procedure TermMode;
Var
Lastchars : String[6];
Ch : Char;
GoodFile : Boolean;
begin
Lastchars := '';
repeat
If Comm_Rx_Ready then
begin
ch := chr(comm_rx);
if Length(lastchars) = 6 then delete(lastchars,1,1);
lastchars := lastchars + ch;
Ansi_write(ch);
if Lastchars = '**'+ chr($18) + 'B00' then
begin
Thenames[1] := Downdir;
Goodfile := zmodemrx;
end;
end;
If Keypressed then
begin
Ch := Readkey;
if ch = #0 then
if Doorway then
begin
Ch := Readkey;
If CH <> #131 then { alt-= }
begin
Comm_TX(0);
Comm_Tx(Ord(ch));
end
else
begin
Doorway := false;
Popup('Doorway mode OFF');
end;
end
else
begin
Ch := Readkey;
case ch of
#25 : SetPort; {Alt_P }
#35 : Hangup; {Alt_H }
#36 : DosShell; {Alt_J }
#45 : Finish := true; {Alt_X }
#48 : SetbaudRate; {Alt_B }
#59 : ShowHelp; {F1 }
#73 : UploadFiles; {PageUp}
#81 : DownloadFiles; {PageDn}
#131 : begin {Alt_= }
Doorway := True;
Popup('Doorway mode ON');
end;
end;
end
else
Comm_Tx(ord(ch));
end;
until finish;
end;
begin
writeln('Term ',version,' - Demo program for the Protocol Engine.');
Writeln('Hit F1 for help - (c) 1992 Mark Dignam - OmenTronics');
TextAttr := LightGray;
CanUseFossil := False;
overwrite := false;
finish := false;
Doorway := False;
CurBaud := 5;
CurPort := 1;
Downdir := '';
GetParms;
IF comm_init(BaudRates[CurBaud],CurPort) then
begin
CurrentSettings;
TermMode;
Comm_deinit;
end
else
begin
Writeln('Sorry - but I can''t initalise port ',curport);
end;
End.